Case 1 Learning Objective 4

Author

Lisa Levoir and Jeffrey Zhuohui Liang

Published

August 29, 2023

1 Analyzing medical students scores

Background given in the case desciprtion: “The course lasts twelve weeks. Throughout the course, students are assessed in multiple ways, including weekly quizzes, slide exams, and essays. They also take an end of course exam that includes essay, short answer, and multiple-choice components. The final data has the average scores for those assessments. Students are required to take laboratory practical (gross anatomy, histology, pathology and neuroanatomy) exams which are averaged into the final grade. Students also take a National Board of Medical Examiners (NBME) standardized exam in each course. Theoretically, if they do well on these exams, they should do well in the course overall. All of the assessments have been calculated on a 100- point scale.”

1.1 Questions from Learning Objective 4

  • How should we define not pass/ marginal pass/ pass thresholds and criteria?
  • How do these thresholds compare to final exam scores

1.2 Data

There are 92 students.

Code
label(dt$quiz)      <- "Quiz score (mean weekly performance)"
label(dt$nbme)      <- "National Board of Medical Examiners score"
label(dt$ga)        <- "GA"
label(dt$slide)      <- "Slide exams score (mean)"
label(dt$part.c)      <- "Part C score"
label(dt$essay)      <- "Essay score (mean)"
label(dt$eob.exam)      <- "EOB exam"
label(dt$final)      <- "Final score"

table1(~quiz + nbme + ga + slide + part.c + essay+ eob.exam + final , data=dt, topclass="Rtable1-zebra",)
Overall
(N=92)
Quiz score (mean weekly performance)
Mean (SD) 0.821 (0.0685)
Median [Min, Max] 0.820 [0.660, 1.00]
National Board of Medical Examiners score
Mean (SD) 89.9 (5.45)
Median [Min, Max] 91.0 [74.0, 100]
GA
Mean (SD) 83.0 (9.89)
Median [Min, Max] 83.9 [49.5, 100]
Slide exams score (mean)
Mean (SD) 82.3 (10.0)
Median [Min, Max] 83.9 [53.1, 100]
Part C score
Mean (SD) 81.1 (8.70)
Median [Min, Max] 81.6 [59.6, 100]
Essay score (mean)
Mean (SD) 86.8 (5.42)
Median [Min, Max] 87.3 [71.3, 95.8]
EOB exam
Mean (SD) 84.9 (6.83)
Median [Min, Max] 85.0 [65.0, 99.0]
Final score
Mean (SD) 88.5 (5.63)
Median [Min, Max] 88.5 [68.0, 100]
Code
length(unique(dt$id))
[1] 92

Questions for Mario:

  • What does GA stand for in the data? What does part.c stand for in the data? What does eob refer to on the exam? Where is the score for the laboratory practical?

  • Can we assume the slide exam score is a mean?

Code
dt = dt %>% 
  mutate(quiz = 100*quiz)

tableby(pass~.,dt %>% 
          select(-id) %>% 
          mutate(pass = final>70),
        control = 
          tableby.control(
            numeric.stats = c("meansd","median","range"),
          )) %>% 
  summary() %>% 
  knitr::kable()
FALSE (N=2) TRUE (N=90) Total (N=92) p value
Quiz score (mean weekly performance) 0.011
   Mean (SD) 70.000 (1.881) 82.377 (6.679) 82.108 (6.853)
   Median 70.000 82.335 82.000
   Range 68.670 - 71.330 66.000 - 100.000 66.000 - 100.000
National Board of Medical Examiners score < 0.001
   Mean (SD) 76.000 (2.828) 90.178 (5.087) 89.870 (5.452)
   Median 76.000 91.000 91.000
   Range 74.000 - 78.000 78.000 - 100.000 74.000 - 100.000
GA 0.002
   Mean (SD) 61.735 (17.317) 83.446 (9.285) 82.974 (9.887)
   Median 61.735 84.439 83.929
   Range 49.490 - 73.980 51.531 - 100.000 49.490 - 100.000
Slide exams score (mean) 0.001
   Mean (SD) 60.455 (2.524) 82.736 (9.558) 82.252 (10.005)
   Median 60.455 84.180 83.925
   Range 58.670 - 62.240 53.060 - 100.000 53.060 - 100.000
Part C score < 0.001
   Mean (SD) 61.410 (2.517) 81.549 (8.271) 81.112 (8.700)
   Median 61.410 81.980 81.590
   Range 59.630 - 63.190 64.230 - 100.000 59.630 - 100.000
Essay score (mean) < 0.001
   Mean (SD) 73.625 (3.359) 87.059 (5.091) 86.767 (5.418)
   Median 73.625 87.250 87.250
   Range 71.250 - 76.000 71.250 - 95.750 71.250 - 95.750
EOB exam < 0.001
   Mean (SD) 66.500 (2.121) 85.322 (6.317) 84.913 (6.833)
   Median 66.500 85.000 85.000
   Range 65.000 - 68.000 69.000 - 99.000 65.000 - 99.000
Final score < 0.001
   Mean (SD) 68.000 (0.000) 88.911 (4.773) 88.457 (5.628)
   Median 68.000 89.000 88.500
   Range 68.000 - 68.000 78.000 - 100.000 68.000 - 100.000
Code
set.seed(123123)
pc = prcomp(dt %>% select(-id,-final) %>% mutate_all(scale))
Code
ggpairs(dt %>% select(-id),
        aes(color=ifelse(final>80,"pass","(almost)fail")),
        progress = F)

Code
cl = kmeans(dt %>% select(-id) %>% mutate_all(scale),
            centers = 4)$cluster
dt %>% left_join(tibble(id = dt$id,cluster = as.factor(cl))) %>% 
  cbind(pc$x) %>% 
  ggplot(aes(x=PC1,y=final,color=cluster)) +
  scale_color_calc()+
  geom_jitter()
Joining with `by = join_by(id)`

Code
autoplot(pc,color = as.factor(cl))
Warning in !(is.vector(value) && length(value) > 1L) && value %in% columns:
'length(x) = 92 > 1' in coercion to 'logical(1)'

1.3 Can I create a better metric?

Code
overall = 
  0.6*rowMeans(dt %>% select(-id,-final,-nbme)) +
  0.4*dt$nbme
dt %>% select(-id) %>% 
  mutate(overall = overall) %>% 
  ggpairs(.,
          aes(color = ifelse(
            overall> quantile(overall,0.05),
            "pass","fail")),
          progress = F)

Code
dt  %>% 
  mutate(overall = overall,
         pass = overall>quantile(overall,0.05)) %>% 
  cbind(pc$x) %>% 
ggplot(aes(y=PC2,x=PC1,color=pass))+
  geom_jitter()

Code
overall = scale(pc$x)[,1:2] %*% c(-0.8,0.2) 

dt %>% select(-id) %>% 
  mutate(overall = as.numeric(overall)) %>% 
  ggpairs(.,
          aes(color = ifelse(
            overall> quantile(overall,0.05),
            "pass","fail")),
          progress = F)

Code
dt  %>% 
  mutate(overall = overall,
         pass = overall>quantile(overall,0.05)) %>% 
  cbind(pc$x) %>% 
ggplot(aes(x=PC1,y=PC2,color=pass))+
  geom_jitter()